Bug Proofing Visual Basic: A Guide to Error Handling and Prevention
(Publisher: John Wiley & Sons, Inc.)
Author(s): Rod Stephens
ISBN: 0471323519
Publication Date: 11/01/98

Program Bad9 is awkward to use and its code is difficult to understand. Both of these problems are caused mainly by the fact that the program violates several of the guidelines presented in this chapter. The program’s bad code follows. Appendix A, “Self-Test Solutions,” contains a greatly improved version of the program.

Option Explicit

Private Const cmd_FIND = 0
Private Const cmd_FIND_RELATIVE = 1
Private Const cmd_BOLD = 2
Private Const cmd_UNBOLD = 3
Private Const cmd_COLOR = 4

Private Const chk_UNDERLINE = 0
Private Const chk_ITALIC = 1
Private Const chk_STRIKETHROUGH = 2

' True when the program is changing display values.
Private SettingValues As Boolean

' Apply the selected command.
Private Sub cmdApply_Click()    
    If optCommand(cmd_FIND) Then
       ' Find and select the indicated text.        
       FindText    
    ElseIf optCommand(cmd_FIND_RELATIVE) Then
       ' Find and select the indicated text.        
       FindTextRelative    
    ElseIf optCommand(cmd_BOLD) Then
       ' Color the selection bold.        
       ColorSelection "Bold"    
    ElseIf optCommand(cmd_UNBOLD) Then
       ' Unbold the selection.        
       rchMainText.SelBold = False    
    ElseIf optCommand(cmd_COLOR) Then
       ' Color the selection.        
       ColorSelection cboSelColor.Text    
    End If        
    
    rchMainText.SetFocus
End Sub

' Find and select the indicated text.
Private Sub FindText()
Dim txt As String
Dim pos As Integer    
    
    txt = rchMainText.Text    
    pos = InStr(txt, txtFindText.Text)    
    If pos = 0 Then        
	Beep    
    Else        
	rchMainText.SelStart = pos - 1        
	rchMainText.SelLength = Len(txtFindText.Text)    
    End If
End Sub

' Find and select the indicated text skipping the
' indicated number of copies.
Private Sub FindTextRelative()
Dim txt As String
Dim target As String
Dim targetlen As Integer
Dim pos As Integer
Dim skip As Integer
Dim trials As Integer    
    
    txt = rchMainText.Text    
    target = txtFindText.Text    
    skip = CInt(txtSkip.Text)    
    
    ' If skip >= 0, search forward from here.    
    If skip >= 0 Then        
	pos = rchMainText.SelStart + 1        
	For trials = 0 To skip            
	    pos = InStr(pos + 1, txt, target)            
	    If pos = 0 Then Exit For        
	Next trials        
	If pos = 0 Then            
	    Beep        
	Else            
	    rchMainText.SelStart = pos - 1            
	    rchMainText.SelLength = Len(txtFindText.Text)        
	End If    
    Else
       ' Skip < 0. Search backwards.        
       targetlen = Len(target)        
       trials = 0        
       skip = -skip        
       For pos = rchMainText.SelStart To 1 Step -1            
	   If Mid$(txt, pos, targetlen) = target Then                
	      trials = trials + 1                
	      If trials >= skip Then Exit For            
	   End If        
       Next pos            
       
       If pos <= 0 Then
	   ' We didn't find it.            
	   Beep        
       Else            
	   rchMainText.SelStart = pos - 1            
	   rchMainText.SelLength = targetlen        
       End If    
   End If
End Sub
' Color the selected text.
Private Sub ColorSelection(color As String)    
    Select Case color        
    Case "Red"            
    rchMainText.SelColor = vbRed        
    Case "Green"            
    rchMainText.SelColor = vbGreen        
    Case "Blue"            
    rchMainText.SelColor = vbBlue        
    Case "Black"            
    rchMainText.SelColor = vbBlack        
    Case "Bold"            
    rchMainText.SelBold = True    
    End Select
End Sub
' Switch the value of the font's property.
Private Sub chkFontOption_Click(Index As Integer)
Dim value As Integer
' Ignore the event if the program is making the change.    
If SettingValues Then Exit Sub    

value = (chkFontOption(Index).value = vbChecked)    
    Select Case Index        
    Case chk_UNDERLINE            
    rchMainText.SelUnderline = value        
    Case chk_ITALIC            
    rchMainText.SelItalic = value        
    Case chk_STRIKETHROUGH            
    rchMainText.SelStrikeThru = value    
    End Select        
    rchMainText.SetFocus
End Sub

' Update the check boxes.
Private Sub rchMainText_SelChange()
' Do not trigger a click event.    
SettingValues = True

' Check the SelUnderline property.    
Select Case rchMainText.SelUnderline        
    Case True            
    chkFontOption(chk_UNDERLINE).value = vbChecked        
    Case False            
    chkFontOption(chk_UNDERLINE).value = vbUnchecked        
    Case Else  ' More than one value.            
    chkFontOption(chk_UNDERLINE).value = vbGrayed    
End Select    

' Check the SelItalic property.    
Select Case rchMainText.SelItalic        
    Case True            
    chkFontOption(chk_ITALIC).value = vbChecked        
    Case False            
    chkFontOption(chk_ITALIC).value = vbUnchecked        
    Case Else  ' More than one value.            

    chkFontOption(chk_ITALIC).value = vbGrayed    
End Select    

' Check the SelStrikeThru property.    
Select Case rchMainText.SelStrikeThru        
Case True            
    chkFontOption(chk_STRIKETHROUGH).value = vbChecked        
    Case False            
    chkFontOption(chk_STRIKETHROUGH).value = vbUnchecked        
    Case Else   ' More than one value.            
    chkFontOption(chk_STRIKETHROUGH).value = vbGrayed    
End Select    
SettingValues = False
End Sub